home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / PHRO.ZIP / STAR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-21  |  3.5 KB  |  170 lines
  1. {   Vector Star Source file                    }
  2. {   PHRO!                                      }
  3. {   Phred/OTM                                  }
  4. {   achalfin@uceng.uc.edu                      }
  5. {   DO NOT DISTRIBUTE THIS SOURCE FILE         }
  6. Unit Star;
  7.  
  8. Interface
  9.  
  10. Procedure VectorStar;
  11.  
  12. Implementation
  13.  
  14. Uses Vector;
  15.  
  16. Type
  17.   tArray = Array[0..256*256-2] of Byte;
  18.   pArray = ^tArray;
  19.  
  20. Var
  21.   StarVoPtr : Pointer;
  22.   EnvMap : pArray;
  23.   VPage : pArray;
  24.   EnvSine : Array[0..255] of Integer;
  25.  
  26. {$L StarVO.Obj}
  27. Procedure StarVo; External;
  28. {$F-}
  29.  
  30. Procedure CalcSine;
  31.  
  32. Var
  33.   Count : Integer;
  34.  
  35. Begin
  36.   For Count := 0 to 255 do
  37.     EnvSine[Count] := Round(Sin(Count*Pi/256)*256);
  38. End;
  39.  
  40. Function FixedMul(M1, M2 : Integer) : Integer; Assembler;
  41.  
  42. Asm
  43.   Mov  ax,M1
  44.   IMul M2
  45.   db 0fh,0ach,0d0h,08h   { Shrd ax,dx,8 }
  46.   Mov  bx,63
  47.   IMul bx
  48.   db 0fh,0ach,0d0h,08h   { Shrd ax,dx,8 }
  49. End;
  50.  
  51. Procedure MakePhongEnv;
  52.  
  53. Var
  54.   PhiCount : Integer;
  55.   ThetaCount : Integer;
  56.  
  57. Begin
  58.   For PhiCount := 0 to 255 do
  59.     For ThetaCount := 0 to 255 do
  60.       EnvMap^[PhiCount Shl 8 + ThetaCount] := (FixedMul(EnvSine[PhiCount], EnvSine[ThetaCount]));
  61. End;
  62.  
  63. Procedure MotionClear(Var D; Step : Byte); Assembler;
  64.  
  65. Asm
  66.   Les  di,D
  67.   Mov  bl,Step
  68.   Mov  cx,64000
  69.  @Looper:
  70.   Mov al,es:[di]  
  71.   Sub al,bl       
  72.   Jns @SkipZero
  73.   Mov al,0
  74.  @SkipZero:
  75.   Mov es:[di],al  
  76.   Inc di
  77.   Dec  cx
  78.   Jnz @Looper
  79. End;
  80.  
  81. Procedure CopyPage(P : Pointer); Assembler;
  82.  
  83. Asm
  84.   Push  ds
  85.   Lds   si,P
  86.   Mov   ax,$A000
  87.   Mov   es,ax
  88.   Xor   di,di
  89.   db 66h; Mov  cx,16000; dw 0;
  90.   db 66h; Rep  Movsw
  91.   Pop   ds
  92. End;
  93.  
  94. Procedure ClearPage(P : Pointer); Assembler;
  95.  
  96. Asm
  97.   Les  di,P
  98.   db 66h; Xor ax,ax
  99.   db 66h; Mov cx,16000; dw 0;
  100.   db 66h; Rep Stosw
  101. End;
  102.  
  103. Procedure SetFadePalette(r1, g1, b1, r2, g2, b2, CStart, CEnd : Byte);
  104.  
  105. Var
  106.   RStep, GStep, BStep : Longint;
  107.   RVal, GVal, BVal : Longint;
  108.   Count : Integer;
  109.  
  110. Begin
  111.   RVal := Longint(R1) Shl 8;
  112.   GVal := Longint(G1) Shl 8;
  113.   BVal := Longint(B1) Shl 8;
  114.   RStep := Longint(R2-R1+1) Shl 8 Div (CEnd-CStart+1);
  115.   GStep := Longint(G2-G1+1) Shl 8 Div (CEnd-CStart+1);
  116.   BStep := Longint(B2-B1+1) Shl 8 Div (CEnd-CStart+1);
  117.   For Count := CStart to CEnd do
  118.     Begin
  119.       Port[$3c8] := Count;
  120.       Port[$3c9] := RVal Div 256;
  121.       Port[$3c9] := GVal Div 256;
  122.       Port[$3c9] := BVal Div 256;
  123.       RVal := RVal + RStep;
  124.       GVal := GVal + gStep;
  125.       BVal := BVal + bStep;
  126.     End;
  127. End;
  128.  
  129. Procedure VectorStar;
  130.  
  131. Var
  132.   Count : Integer;
  133.   Angle : Integer;
  134.  
  135. Begin
  136.   New(EnvMap);
  137.   New(VPage);
  138.   SetFadePalette(12, 0, 12, 48, 32, 48, 1, 49);
  139.   SetFadePalette(48, 32, 48, 63, 53, 63, 50, 63);
  140.   InitVectorRoutines(250);
  141.   LoadVectorObject(StarVOPtr, 0, cPhongPoly);
  142.   SelectEnable(0, 1, EnvMap);  { Enable face vector object, with phong tmap }
  143.   Angle := 0;
  144.   For Count := -130 to 0 do
  145.     Begin
  146.       Location(0, Count*3, Count*2, Abs(Count*2)+200, Angle, 0, Angle);
  147.       MotionClear(VPage^, 5);
  148.       DisplayVectorObjects(Seg(VPage^));
  149.       CopyPage(VPage);
  150.       Angle := (Angle + 3) and 511;
  151.     End;
  152.   For Count := 1 to 130 do
  153.     Begin
  154.       Location(0, Count*3, Count*2, Abs(Count*2)+200, Angle, 0, Angle);
  155.       MotionClear(VPage^, 5);
  156.       DisplayVectorObjects(Seg(VPage^));
  157.       CopyPage(VPage);
  158.       Angle := (Angle + 3) and 511;
  159.     End;
  160.   FreeVectorObject(0);
  161.   CloseVectorRoutines;
  162.   Dispose(VPage);
  163.   Dispose(EnvMap);
  164. End;
  165.  
  166. Begin
  167.   CalcSine;
  168.   StarVOPtr := @StarVO;
  169. End.
  170.